home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / chckrs.exe / CHCKRS.PAS < prev   
Pascal/Delphi Source File  |  1993-05-13  |  9KB  |  385 lines
  1. Program Damas;
  2.  
  3. uses
  4.    Crt;
  5.  
  6. var
  7.    Ch,Piez1,Piez2,PiezAct : Char;
  8.    Archivo,Turno,Jug1,Jug2,LinArr,LinAba,Lin1,Lin2 : String;
  9.    t : String[80];
  10.    Comidas1,Comidas2,Empieza,x,y,z,a,b,c,p,q,j,k : Integer;
  11.    Selec,Salir : Boolean;
  12.    f : text;
  13.    Fichas : array[1..8, 1..4] of Char;
  14.  
  15. Procedure Inicio;
  16.    begin
  17.       ClrScr;
  18.       Write('Jugador #1: ');
  19.       ReadLn(Jug1);
  20.       Write('Jugador #2: ');
  21.       ReadLn(Jug2);
  22.       WriteLn;
  23.       Write('"Quin juega primero? (1 c 2): ');
  24.       ReadLn(t);
  25.       Jug2 := Jug2 + #32;
  26.       Val(t,Empieza,x);
  27.       Piez1 := 'x';
  28.       Piez2 := 'o';
  29.       if ((Empieza <> 1) or (Empieza <> 2)) then Empieza := 1;
  30.       if Empieza = 2 then begin
  31.          Turno := Jug2;
  32.          PiezAct := Piez2; end
  33.       else if Empieza = 1 then begin
  34.          Turno := Jug1;
  35.          PiezAct := Piez1; end;
  36.       Comidas1 := 0;
  37.       Comidas2 := 0;
  38.       for x := 1 to 3 do
  39.       begin
  40.          for y := 1 to 4 do
  41.          begin
  42.             Fichas[x,y] := 'x';
  43.             Fichas[x+2,y] := '.';
  44.             Fichas[x+5,y] := 'o';
  45.          end;
  46.       end;
  47.       a := 4;
  48.       b := 2;
  49.       Selec := False;
  50.       Salir := False;
  51.    end;
  52.  
  53. Procedure Tablero;
  54.    begin
  55.       ClrScr;
  56.       LinArr := #201;
  57.       LinAba := #200;
  58.       Lin1 := #186;
  59.       Lin2 := #199;
  60.       for x := 1 to 7 do
  61.       begin
  62.          LinArr := LinArr + #205#205#205#205#209;
  63.          LinAba := LinAba + #205#205#205#205#207;
  64.          Lin1   := Lin1 + #32#32#32#32#179;
  65.          Lin2   := Lin2 + #196#196#196#196#197;
  66.       end;
  67.       LinArr := LinArr + #205#205#205#205#187;
  68.       LinAba := LinAba + #205#205#205#205#188;
  69.       Lin1   := Lin1 + #32#32#32#32#186;
  70.       Lin2   := Lin2 + #196#196#196#196#182;
  71.       WriteLn(LinArr);
  72.       for x := 1 to 7 do
  73.       begin
  74.          WriteLn(Lin1);
  75.          WriteLn(Lin2);
  76.       end;
  77.       WriteLn(Lin1);
  78.       WriteLn(LinAba);
  79.       GotoXY(45,2);
  80.       Write('Jugador #1: ',Jug1);
  81.       GotoXY(45,15);
  82.       Write('Jugador #2: ',Jug2);
  83.       GotoXY(48,3);
  84.       Write('Comidas: ');
  85.       GotoXY(48,16);
  86.       Write('Comidas: ');
  87.       GotoXY(50,9);
  88.       Write('TURNO');
  89.       GotoXY(5,20);
  90.       WriteLn('Use '#24,',',#25,',',#27,' y ',#26,' para mover el cursor.');
  91.       GotoXY(5,21);
  92.       WriteLn('ESPACIO para seleccionar pieza a mover.         ');
  93.       GotoXY(5,22);
  94.       WriteLn('ESC para salir del juego.                     ');
  95.       for x := 1 to 4 do
  96.       begin
  97.          z := 0;
  98.          for y := 1 to 4 do
  99.          begin
  100.             GotoXY(4+z,4*x-2);
  101.             Write(Fichas[2*x-1,y]);
  102.             Inc(z,10);
  103.          end;
  104.          WriteLn;
  105.       end;
  106.       for x := 1 to 4 do
  107.       begin
  108.          z := 5;
  109.          for y := 1 to 4 do
  110.          begin
  111.             GotoXY(4+z,4*x);
  112.             Write(Fichas[2*x,y]);
  113.             Inc(z,10);
  114.          end;
  115.          WriteLn;
  116.       end;
  117.    end;
  118.  
  119. Procedure Status;
  120.    begin
  121.       GotoXY(57,3);
  122.       Write(Comidas1);
  123.       GotoXY(57,16);
  124.       Write(Comidas2);
  125.       GotoXY(52,8);
  126.       Write(#32);
  127.       GotoXY(52,10);
  128.       Write(#32);
  129.       if Turno = Jug1 then
  130.          begin
  131.             GotoXY(52,8);
  132.             Write(#24);
  133.          end;
  134.       if Turno = Jug2 then
  135.          begin
  136.             GotoXY(52,10);
  137.             Write(#25);
  138.          end;
  139.    end;
  140.  
  141. Procedure SelectOff;
  142.    begin
  143.      GotoXY(5,20);
  144.      WriteLn('Use '#24,',',#25,',',#27,' y ',#26,' para mover el cursor.');
  145.      GotoXY(5,21);
  146.      WriteLn('ENTER para mover la pieza a la posicicn deseada.');
  147.      GotoXY(5,22);
  148.      WriteLn('ESPACIO para des-seleccionar la pieza marcada.');
  149.      if b mod 2 = 0 then
  150.        begin
  151.          x := (b div 2);
  152.          y := (a div 10) + 1;
  153.        end
  154.      else
  155.        begin
  156.          x := (b div 2) - 1;
  157.          y := (a div 10) - 4;
  158.        end;
  159.      GotoXY(a,b);
  160.      TextColor(135);
  161.      Write(Fichas[x,y]);
  162.      NormVideo;
  163.      c := a;
  164.      z := b;
  165.      Selec := True;
  166.    end;
  167.  
  168. Procedure Comer;
  169.    begin
  170.      if Turno = Jug1 then
  171.        begin
  172.          Inc(Comidas1);
  173.        end
  174.      else
  175.        begin
  176.          Inc(Comidas2);
  177.      end;
  178.    end;
  179.  
  180. Procedure Invalido;
  181.    begin
  182.      GotoXY(10,18);
  183.      TextColor(135);
  184.      Write('Movimiento inv lido!  Por favor intente de nuevo.');
  185.      repeat until KeyPressed;
  186.      GotoXY(10,18);
  187.      NormVideo;
  188.      for x := 1 to 70 do Write(#32);
  189.      Exit;
  190.    end;
  191.  
  192. Procedure SelectOn;
  193.    begin
  194.      Status;
  195.      GotoXY(5,20);
  196.      WriteLn('Use '#24,',',#25,',',#27,' y ',#26,' para mover el cursor.');
  197.      GotoXY(5,21);
  198.      WriteLn('ESPACIO para seleccionar pieza a mover.         ');
  199.      GotoXY(5,22);
  200.      WriteLn('ESC para salir del juego.                     ');
  201.      if b mod 2 = 0 then
  202.        begin
  203.          p := (b div 2);
  204.          q := (a div 10) + 1;
  205.        end
  206.      else
  207.        begin
  208.          p := (b div 2) - 1;
  209.          q := (a div 10) - 4;
  210.        end;
  211.      if (p = x) and (q = y) then
  212.        begin
  213.          GotoXY(a,b);
  214.          TextColor(7);
  215.          Write(Fichas[x,y]);
  216.          NormVideo;
  217.          if Selec = True then Selec := False;
  218.          Exit;
  219.        end;
  220.      if (((p = x+1) or (p = x-1)) and ((q=y) or (q = y+1) or (q = y-1))) then
  221.        begin
  222.          if p = x+1 then
  223.            if PiezAct = Piez2 then
  224.              begin
  225.                Invalido;
  226.                GotoXY(c,z);
  227.                NormVideo;
  228.                Write(Fichas[x,y]);
  229.                Exit;
  230.              end;
  231.          if p = x-1 then
  232.            if PiezAct = Piez1 then
  233.              begin
  234.                Invalido;
  235.                GotoXY(c,z);
  236.                NormVideo;
  237.                Write(Fichas[x,y]);
  238.                Exit;
  239.              end;
  240.          GotoXY(c,z);
  241.          Write('.');
  242.          GotoXY(a,b);
  243.          Write(Fichas[x,y]);
  244.          Fichas[p,q] := Fichas[x,y];
  245.          Fichas[x,y] := '.';
  246.          if Turno = Jug1 then
  247.            begin
  248.              Turno := Jug2;
  249.              PiezAct := Piez2;
  250.            end
  251.            else
  252.            begin
  253.              Turno := Jug1;
  254.              PiezAct := Piez1;
  255.            end;
  256.          if Selec = True then Selec := False;
  257.          Exit;
  258.        end;
  259.      if (((p = x+2) or (p = x-2)) and ((q=y) or (q = y+1) or (q = y-1))) then
  260.        begin
  261.          GotoXY(c,z);
  262.          Write('.');
  263.          GotoXY(a,b);
  264.          Write(Fichas[x,y]);
  265.          Fichas[p,q] := Fichas[x,y];
  266.          Fichas[x,y] := '.';
  267.          if p = x+2 then
  268.            j := -2
  269.          else
  270.            j := 2;
  271.          if ((q=y+1) or ((q=y) and (c<a))) then
  272.          begin
  273.            GotoXY(a-5,b+j);
  274.            Write('.');
  275.            Fichas[x-1,y-1] := '.';
  276.          end;
  277.          if ((q=y-1) or ((q=y) and (c>a))) then
  278.          begin
  279.            GotoXY(a+5,b+j);
  280.            Write('.');
  281.            Fichas[x-1,y+1] := '.';
  282.          end;
  283.          Fichas[p,q] := Fichas[x,y];
  284.          Fichas[x,y] := '.';
  285.          Comer;
  286.          if Turno = Jug1 then Turno := Jug2
  287.            else Turno := Jug1;
  288.          if Selec = True then Selec := False;
  289.          Exit;
  290.        end;
  291.      GotoXY(c,z);
  292.      TextColor(7);
  293.      Write(Fichas[x,y]);
  294.      NormVideo;
  295.      Selec := False;
  296.    end;
  297.  
  298. Procedure Escape;
  299.    begin
  300.      ClrScr;
  301.      WriteLn('Juego Terminado ...');
  302.      WriteLn;
  303.      WriteLn('1. Guardar el juego actual en disco');
  304.      WriteLn('2. Salir sin guardar');
  305.      WriteLn;
  306.      Write('Opcicn: ');
  307.      ReadLn(t);
  308.      Val(t,x,y);
  309.      case x of
  310.      1:
  311.        begin
  312.          WriteLn;
  313.          Write('Ingrese el nombre del archivo (sin extensicn / 8 chars. m x): ');
  314.          ReadLn(Archivo);
  315.          a := 10-Length(Jug1);
  316.          b := 10-Length(Jug2);
  317.          for x := 0 to a do Jug1 := Jug1 + ' ';
  318.          for x := 0 to b do Jug2 := Jug2 + ' ';
  319.          Archivo := Copy(Archivo,1,8) + '.DAM';
  320.          Assign(f, Archivo);
  321.          Rewrite(f);
  322.          WriteLn(f, Jug1, Piez1);
  323.          WriteLn(f, Jug2, Piez2);
  324.          for x := 1 to 8 do
  325.            begin
  326.              for y := 1 to 4 do
  327.